Dr. Windows 3/dr win3.zip/dr win3/UTILITY1/MSWLGO35.ZIP/EXAMPLES/CRYPTO

Text File | 1993-04-11 | 7KB | 322 lines

;
; This uses cursor addressing (not avail in MswLogo) could be reworked though
;
TO ALPHABET :STRING
IF EMPTYP :STRING [STOP]
IF NAMEP THING FIRST :STRING [LIGHT THING FIRST :STRING]
ALPHABET BF :STRING
END

TO BEEP
TYPE CHAR 7
END

TO BIND :FROM :TO
IF NOT NAMEP :FROM [BEEP STOP]
IF NAMEP WORD "BOUND :TO [BEEP STOP]
IF NAMEP THING :FROM [DARK THING :FROM]
MAKE :FROM :TO
FIXHIST :FROM
IF NAMEP :TO [LIGHT :TO]
SHOWCLEAR :TEXT
END

TO BINDLOOP
PARSEKEY RC
BINDLOOP
END

TO CLEARLET :LETTER
IFELSE NAMEP :LETTER [TYPE THING :LETTER] [TYPE :LETTER]
END

TO CLEARTYPE :WORD
IF EMPTYP :WORD [STOP]
CLEARLET FIRST :WORD
CLEARTYPE BF :WORD
END

TO CLEARWORD :ROW :COL :WORD
SETCURSOR LIST :COL :ROW+1
CLEARTYPE :WORD
END

TO CNT :LETTER
OUTPUT THING (WORD "CNT :LETTER)
END

TO CODEWORD :ROW :COL :WORD
SETCURSOR LIST :COL :ROW
INVTYPE :WORD
END

TO COUNT. :WORD
OUTPUT THING (WORD "COUNT. :WORD)
END

TO CRYPTO :TEXT
MAKE "FULLTEXT :TEXT
MAKE "MORETEXT []
MAKE "TEXTSTACK []
INITVARS "A "Z
MAKE "MAXCOUNT 0
INITCOUNT "SINGLE
INITCOUNT "TRIPLE
CT
HISTOGRAM :TEXT
REDISPLAY "FALSE
IF OR GUESS.SINGLE GUESS.TRIPLE [SHOWCLEAR :TEXT]
BINDLOOP
END

TO DARK :LETTER
SETCURSOR LIST 6+(ASCII :LETTER)-(ASCII "A) 6
TYPE :LETTER
ERN WORD "BOUND :LETTER
END

TO FIXHIST :LETTER
SETCURSOR THING WORD "POS :LETTER
ONEHIST :LETTER
END

TO FULLCLEAR
CT
SHOWCLEAR1 0 0 :FULLTEXT 1
PR []
INVTYPE [TYPE ANY CHAR TO REDISPLAY]
IGNORE RC
REDISPLAY "TRUE
END

TO GUESS.SINGLE
IF EMPTYP :LIST.SINGLE [OP "FALSE]
IF EMPTYP BF :LIST.SINGLE [QBIND FIRST :LIST.SINGLE "A OP "TRUE]
QBIND :MAX.SINGLE "A
QBIND (IFELSE EQUALP FIRST :LIST.SINGLE :MAX.SINGLE ~
                     [LAST :LIST.SINGLE] [FIRST :LIST.SINGLE]) "I
OP "TRUE
END

TO GUESS.TRIPLE
IF EMPTYP :LIST.TRIPLE [OP "FALSE]
IF :MAXCOUNT < (3+CNT LAST :MAX.TRIPLE)     ~
      [QBIND FIRST :MAX.TRIPLE "T     ~
       QBIND FIRST BF :MAX.TRIPLE "H     ~
       QBIND LAST :MAX.TRIPLE "E     ~
       OP "TRUE]
OP "FALSE
END

TO HISTCHAR :CHAR
IF NAMEP :CHAR [HISTLET :CHAR OP :CHAR]
OP "
END

TO HISTLET :LETTER
LOCAL "CNT
MAKE "CNT 1+CNT :LETTER
SETCURSOR LIST (ASCII :LETTER)-(ASCII "A) (NONNEG 24-:CNT)
TYPE :LETTER
SETCNT :LETTER :CNT
IF :MAXCOUNT < :CNT [MAKE "MAXCOUNT :CNT]
END

TO HISTOGRAM :TEXT
IF EMPTYP :TEXT [STOP]
PREPARE.GUESS HISTWORD FIRST :TEXT
HISTOGRAM BF :TEXT
END

TO HISTWORD :WORD
IF EMPTYP :WORD [OP " ]
OP WORD HISTCHAR FIRST :WORD HISTWORD BF :WORD
END

TO INITCOUNT :TYPE
SETLIST. :TYPE []
SETCOUNT. :TYPE 0
END

TO INITVARS :FROM :TO
SETCNT :FROM 0
MAKE :FROM "| |
IF NAMEP WORD "BOUND :FROM [ERN WORD "BOUND :FROM]
IF EQUALP :FROM :TO [STOP]
INITVARS CHAR 1+ASCII :FROM :TO
END

TO INVTYPE :TEXT
TYPE STANDOUT :TEXT
END

TO LESSTEXT
IF EMPTYP :TEXTSTACK [STOP]
MAKE "TEXT FIRST :TEXTSTACK
MAKE "TEXTSTACK BF :TEXTSTACK
REDISPLAY "TRUE
END

TO LIGHT :LETTER
SETCURSOR LIST 6+(ASCII :LETTER)-(ASCII "A) 6
INVTYPE :LETTER
MAKE WORD "BOUND :LETTER "TRUE
END

TO LIST. :WORD
OUTPUT THING (WORD "LIST. :WORD)
END

TO MORETEXT
IF EMPTYP :MORETEXT [STOP]
MAKE "TEXTSTACK FPUT :TEXT :TEXTSTACK
MAKE "TEXT :MORETEXT
REDISPLAY "TRUE
END

TO NONNEG :NUMBER
OP IFELSE :NUMBER < 0 [0] [:NUMBER]
END

TO ONEHIST :LETTER
POST (WORD :LETTER "- TWOCOL CNT :LETTER "- THING :LETTER) ~
       CNT :LETTER
TYPE "| |
END

TO PARSEKEY :CHAR
IF :CHAR = "@ [FULLCLEAR STOP]
IF :CHAR = "+ [MORETEXT STOP]
IF :CHAR = "- [LESSTEXT STOP]
BIND :CHAR RC
END

TO POST :TEXT :COUNT
IF :COUNT = 0 [TYPE WORD FIRST :TEXT "|     | STOP]
IFELSE :MAXCOUNT < :COUNT+3 [INVTYPE :TEXT] [TYPE :TEXT]
END

TO PREPARE.GUESS :WORD
IF EQUALP COUNT :WORD 1 [TALLY "SINGLE :WORD]
IF EQUALP COUNT :WORD 3 [TALLY "TRIPLE :WORD]
END

TO QBIND :FROM :TO
IF NAMEP THING :FROM [STOP]
MAKE :FROM :TO
FIXHIST :FROM
LIGHT :TO
END

TO REDISPLAY :FLAG
CT
SHOWHIST
SETCURSOR [6 6]
TYPE "ABCDEFGHIJKLMNOPQRSTUVWXYZ
IF :FLAG [ALPHABET "ABCDEFGHIJKLMNOPQRSTUVWXYZ]
SHOWCODE :TEXT
IF :FLAG [SHOWCLEAR :TEXT]
END

TO SETCNT :LETTER :THING
MAKE (WORD "CNT :LETTER) :THING
END

TO SETCOUNT. :WORD :THING
MAKE (WORD "COUNT. :WORD) :THING
END

TO SETLIST. :WORD :THING
MAKE (WORD "LIST. :WORD) :THING
END

TO SHOWCLEAR :TEXT
SHOWCLEAR1 8 0 :TEXT 2
END

TO SHOWCLEAR1 :ROW :COL :TEXT :DELTA
IF EMPTYP :TEXT [STOP]
IF :ROW > 23 [STOP]
IF KEYP [STOP]
IF (:COL+COUNT FIRST :TEXT) > 37 ~
   [SHOWCLEAR1 :ROW+:DELTA 0 :TEXT :DELTA STOP]
CLEARWORD :ROW :COL FIRST :TEXT
SHOWCLEAR1 :ROW (:COL+1+COUNT FIRST :TEXT) BF :TEXT :DELTA
END

TO SHOWCODE :TEXT
MAKE "MORETEXT []
SHOWCODE1 8 0 :TEXT
END

TO SHOWCODE1 :ROW :COL :TEXT
IF EMPTYP :TEXT [MAKE "MORETEXT [] STOP]
IF :ROW > 22 [STOP]
IF AND EQUALP :ROW 16 EQUALP :COL 0 [MAKE "MORETEXT :TEXT]
IF (:COL+COUNT FIRST :TEXT) > 37 [SHOWCODE1 :ROW+2 0 :TEXT STOP]
CODEWORD :ROW :COL FIRST :TEXT
SHOWCODE1 :ROW (:COL+1+COUNT FIRST :TEXT) BF :TEXT
END

TO SHOWHIST
SHOWROW 0 "A 5
SHOWROW 1 "F 5
SHOWROW 2 "K 5
SHOWROW 3 "P 5
SHOWROW 4 "U 5
SHOWROW 5 "Z 1
END

TO SHOWROW :ROW :LETTER :NUM
SETCURSOR LIST 0 :ROW
SHOWROW1 :LETTER :NUM :ROW 0
END

TO SHOWROW1 :LETTER :NUM :ROW :COL
IF :NUM = 0 [STOP]
MAKE WORD "POS :LETTER LIST :COL :ROW
ONEHIST :LETTER
SHOWROW1 CHAR 1+ASCII :LETTER :NUM-1 :ROW :COL+7
END

TO TALLY :TYPE :WORD
LOCAL "THIS
MAKE "THIS WORD :TYPE :WORD
IF NOT MEMBERP :WORD LIST. :TYPE ~
     [SETLIST. :TYPE FPUT :WORD LIST. :TYPE MAKE :THIS 0]
MAKE :THIS SUM 1 THING :THIS
MAKE "THIS THING :THIS
IF :THIS > (COUNT. :TYPE) ~
     [SETCOUNT. :TYPE :THIS MAKE (WORD "MAX. :TYPE) :WORD]
END

TO TWOCOL :NUMBER
IF :NUMBER > 9 [OP :NUMBER]
OP WORD 0 :NUMBER
END


MAKE "CGRAM1 [DZYNUFQYJULLI, JPQHQ OK YR HOXPJ QNZEUJORY QCEQWJ XHRTOYX ~
   ZW OYJR U TRHJPTPOLQ TRHLN. OYNQQN, RZH QCEQKKOGQ ERYEQHY TOJP ~
   WHRVLQFK RD QNZEUJORY UJ WHQKQYJ KOFWLI FQUYK JPUJ JPQ |XHRTY-ZWK| NR ~
   YRJ PUGQ KZEP U TRHLN. U NQEQYJ QNZEUJORY UOFK UJ, WHQWUHQK DRH, U ~
   FRHQ TRHJPTPOLQ DZJZHQ, TOJP U NODDQHQYJ ERFFZYOJI KWOHOJ, NODDQHQYJ ~
   REEZWUJORYK, UYN FRHQ HQUL ZJOLOJI JPUY UJJUOYOYX KJUJZK UYN KULUHI.]
MAKE "CGRAM2 [LVO VFKP LFZJ MD OPAXFLIMN IZ LM GITOKFLO FNP ZLKONBLVON F ~
   HMALV'Z INILIFLIUO, FNP FL LVO ZFYO LIYO LM ZOO LM IL LVFL VO JNMWZ ~
   WVFL IZ NOXOZZFKH LM XMCO WILV LVO MNBMINB FXLIUILIOZ FNP XAGLAKO MD ~
   ZMXIOLH, ZM LVFL VIZ INILIFLIUO XFN TO KOGOUFNL. IL IZ FTZAKP LM ~
   LVINJ LVFL LVIZ LFZJ XFN TO FXXMYCGIZVOP TH ZM YAXV ZILLINB IN F TMS ~
   DFXINB DKMNL, YFNICAGFLINB ZHYTMGZ FL LVO PIKOXLIMN MD PIZLFNL ~
   FPYINIZLKFLMKZ. LVIZ IZ KFLVOK F WFH LM KOBIYONL FNP TKFINWFZV.]
MAKE "CGRAM3 [PCODL HBDCX QXDRDLH YIHCODR, HBD RZBIIER GXD LIH ZIYQDHDLH ~
   HI HDGZB GWHBDLHCZ ECHDXGZF, XDGNCLP GR G YDGLR IA ECUDXGHCIL GLN ~
   ZWEHCOGHCIL. GLN C NIWUH HBGH YIRH IA WR JBI RDXCIWREF XDGN GLN JXCHD ~
   HBD DLPECRB EGLPWGPD DODX EDGXLDN CH UF HBD XIWHD IA "XWL, RQIH, XWL" ~
   HI RCEGR YGXLDX.]
MAKE "CGRAM4 [JW BTN XNSGSYP EJKE GFEBBCG, DTYJBN FBCCSKSG, RYU FBCCSKSG ~
   NSWCSFPSU PES USGJNS, WNSSUBA, RYU WTPTNS BW PES QBTYK, PESNS ZBTCU ~
   LS YB KNRUJYK, YB PSGPJYK SVFSXP RG R PSRFEJYK ASPEBU, RYU YB ~
   LCRFILBRNU DTYKCSG. JY WRFP, ZS RNS KSPPJYK CBFIGPSX GFESUTCJYK RYU ~
   KNRUJYK PB PES XBJYP BW PBNPTNS.]